PCMania 73/PCMania CD73_1.iso/pcmania/demosc73/GRAF.PAS

Pascal/Delphi Source File | 1998-05-11 | 5KB | 276 lines

{$G+}
unit graf;

INTERFACE

CONST
     VGA :pointer=PTR($a000,$0);

TYPE
    color  = record
             r,g,b : byte;
             end;
    paleta = array [0..255] of color;

PROCEDURE Set_vga;
PROCEDURE Set_text;
PROCEDURE Cls(color:byte;VAR donde);
PROCEDURE Flip(VAR desde,hasta);
PROCEDURE PutRGB(Color,R,G,B : Byte);
PROCEDURE GetRGB(Color:byte; VAR R, G, B:byte);
PROCEDURE Border(col:BYTE);
PROCEDURE Putpaleta(pal:paleta);
PROCEDURE Getpaleta(VAR pal:paleta);
PROCEDURE EsperaVGA;
PROCEDURE Lee_pcx(Var origen; cont:word;VAR destino);
PROCEDURE Load_pcx (origen:String;VAR destino);
PROCEDURE Putpixel (X,Y : Integer; Col : Byte; where:word);
PROCEDURE Line(x1, y1, x2, y2 : integer; color : byte; var donde);

IMPLEMENTATION

PROCEDURE Set_vga; ASSEMBLER;
ASM
   mov ax,13h
   int 10h
END;

PROCEDURE Set_text; ASSEMBLER;
ASM
   mov ax,3h
   int $10
END;

PROCEDURE Cls(color:byte;VAR donde);ASSEMBLER;
ASM
   les di,donde
   mov al,byte ptr color
   mov ah,al
   db  $66, $c1, $e0, $10
   mov al,byte ptr color
   mov ah,al
   mov cx,16000
   db  $f3,$66,$ab
end;

Procedure Flip (VAR desde,hasta); Assembler;
ASM
   mov  bx,ds
   lds  si,desde
   les  di,hasta
   mov  cx,16000
   db   $f3,$66,$a5    {rep movsd}
   mov  ds,bx
end;

PROCEDURE PutRGB(Color,R,G,B : Byte);
BEGIN
     Port[$3c8]:=Color;
     Port[$3c9]:=R;
     Port[$3c9]:=G;
     Port[$3c9]:=B;
END;

PROCEDURE GetRGB(Color:byte; VAR R, G, B:byte);
BEGIN
     Port[$3c7]:=Color;
     R:=Port[$3c9];
     G:=Port[$3c9];
     b:=Port[$3c9];
END;

PROCEDURE Border(col:BYTE); ASSEMBLER;
ASM
        mov ax,1001h
        mov bh,col
        int 10h
END;

PROCEDURE PutPaleta (pal:paleta);
VAR
      cont : integer;
BEGIN
      Port[$3c8]:=0;
      for cont:=0 to 255 do begin
          Port[$3c9]:=pal[cont].r;
          Port[$3c9]:=pal[cont].g;
          Port[$3c9]:=pal[cont].b;
      end;
END;

PROCEDURE GetPaleta (VAR pal:paleta);
VAR
      cont : integer;
BEGIN
      for cont:=0 to 255 do
      GetRGB(cont,pal[cont].r,pal[cont].g,pal[cont].b);
END;

PROCEDURE EsperaVGA; assembler;
asm
    mov dx,3DAh
@l1:
    in al,dx
    and al,08h
    jnz @l1
@l2:
    in al,dx
    and al,08h
    jz  @l2
end;


PROCEDURE Putpixel (X,Y : Integer; Col : Byte; where :word);ASSEMBLER;
ASM
    mov      ax,where
    mov      es,ax
    mov      bx,[X]
    mov      dx,[Y]
    mov      di,bx
    mov      bx, dx
    shl      dx, 8
    shl      bx, 6
    add      dx, bx
    add      di, dx
    mov      al, [Col]
    mov      es:[di],al
END;

procedure Line(x1, y1, x2, y2 : integer; color : byte; var donde);
var i, deltax, deltay, numpixels,
    d, dinc1, dinc2,
    x, xinc1, xinc2,
    y, yinc1, yinc2 : integer;
    sdonde,odonde   : word;
begin

  sdonde:=seg(donde);
  odonde:=ofs(donde);

  deltax := abs(x2 - x1);
  deltay := abs(y2 - y1);
  if deltax >= deltay then
    begin
      numpixels := deltax + 1;
      d := (2 * deltay) - deltax;
      dinc1 := deltay Shl 1;
      dinc2 := (deltay - deltax) shl 1;
      xinc1 := 1;
      xinc2 := 1;
      yinc1 := 0;
      yinc2 := 1;
    end
  else
    begin
      numpixels := deltay + 1;
      d := (2 * deltax) - deltay;
      dinc1 := deltax Shl 1;
      dinc2 := (deltax - deltay) shl 1;
      xinc1 := 0;
      xinc2 := 1;
      yinc1 := 1;
      yinc2 := 1;
    end;

  { Make sure x and y move in the right directions }
  if x1 > x2 then
    begin
      xinc1 := - xinc1;
      xinc2 := - xinc2;
    end;
  if y1 > y2 then
    begin
      yinc1 := - yinc1;
      yinc2 := - yinc2;
    end;
  for i := 1 to numpixels do
    begin
      MEM[sdonde:odonde+x1+y1*320]:=color;
      if d < 0 then
        begin
          d  := d + dinc1;
          x1 := x1 + xinc1;
          y1 := y1 + yinc1;
        end
      else
        begin
          d  := d + dinc2;
          x1 := x1 + xinc2;
          y1 := y1 + yinc2;
        end;
    end;
end;



Procedure Lee_pcx(Var origen; cont:word; VAR destino);ASSEMBLER;
ASM
   push  DS
   sub   cont,768
   lds   si, origen
   add   si, cont
   mov   cx, 256

   mov   dx, $3c8
   mov   al, 0
   out   dx, al
   mov   dx, $3c9

 @@divide:
   lodsb
   shr   al, 2
   out   dx, al
   lodsb
   shr   al, 2
   out   dx, al
   lodsb
   shr   al, 2
   out   dx, al
   sub   cx, 1
   jnz   @@divide

   les   di, destino
   lds   si, origen
   add   si, 128
   mov   dx, cont
   sub   dx, 1

 @@bucle:
   lodsb
   cmp   al, 192
   Jb    @@norepite
   sub   al, 192
   mov   cl, al
   lodsb
   jmp   @@escribe

 @@norepite:
   mov   cx, 1

 @@escribe:
   rep   stosb
   cmp   si, dx
   jnz   @@bucle

 @@end:
   pop ds
END;

PROCEDURE Load_pcx (origen:String;VAR destino);
VAR
   pointr  : Pointer;
   fichero : file;
   tamany  : word;
BEGIN
     assign (fichero,origen);
     reset (fichero,1);
     getmem (pointr,filesize(fichero));
     blockread (fichero,pointr^,filesize(fichero),tamany);
     lee_pcx (pointr^,tamany,destino);
     Freemem (pointr,filesize(fichero));
     close (fichero);
end;

begin
end.